Import data
df_coop_homo <- do.call(rbind, lapply(Sys.glob("../control_group/data/coop_ratio/*.csv"), read_csv))
df_coop_max <- do.call(rbind, lapply(Sys.glob("../*max/data/coop_ratio/*.csv"), read_csv))
df_coop_min <- do.call(rbind, lapply(Sys.glob("../*min/data/coop_ratio/*.csv"), read_csv))
full <- df_coop_homo %>%
rbind(df_coop_max) %>%
rbind(df_coop_min)
rm(df_coop_homo,df_coop_max,df_coop_min)
Analysis of cooperation ratio
full %>%
group_by(tournament_type, seed) %>%
summarise(mean_coop = mean(coop_ratio),
sd_coop = sd(coop_ratio)) %>%
ggplot(aes(x = as.factor(tournament_type), y = mean_coop, fill = tournament_type)) +
geom_bar(stat="identity") +
geom_errorbar(aes(ymin = mean_coop-sd_coop, ymax = mean_coop + sd_coop), width = .7) +
facet_wrap(~seed) +
coord_flip() +
scale_fill_grey(guide = F) +
labs(title = "Mean cooperation ratio and standard deviation per tournament type, facetted by seed",
y = "cooperatio ratio",
x = " ")
full %>%
group_by(tournament_type, seed) %>%
summarise(mean_coop = mean(coop_ratio),
sd_coop = sd(coop_ratio)) %>%
ggplot(aes(x = as.factor(seed), y = mean_coop, fill = tournament_type)) +
geom_bar(stat="identity") +
geom_errorbar(aes(ymin = mean_coop-sd_coop, ymax = mean_coop + sd_coop), width = .7) +
facet_wrap(~tournament_type) +
coord_flip() +
scale_fill_grey(guide = F) +
labs(title = "Mean cooperation ratio and standard deviation per seed, facetted by tournament type",
y = "cooperatio ratio",
x = " ")
full %>%
group_by(tournament_type) %>%
summarise(mean_coop = mean(coop_ratio),
sd_coop = sd(coop_ratio)) %>%
arrange(desc(mean_coop)) %>%
kable(caption = "Tournament types arranged by mean of cooperation ratio") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
| tournament_type | mean_coop | sd_coop |
|---|---|---|
| hetero_dr_sd_max | 0.6002804 | 0.1605549 |
| homogenous | 0.5892130 | 0.1542594 |
| pareto_m_max | 0.5886649 | 0.1566004 |
| hetero_m_sd_max | 0.5859083 | 0.1568820 |
| pareto_mdr_max | 0.5825757 | 0.1616499 |
| hetero_mdr_sd_max | 0.5817933 | 0.1660426 |
| hetero_m_sd_min | 0.5799698 | 0.1605414 |
| pareto_dr_max | 0.5795952 | 0.1543603 |
| hetero_mdr_sd_min | 0.5793128 | 0.1596192 |
| hetero_dr_sd_min | 0.5789166 | 0.1612046 |
| pareto_m_min | 0.5747713 | 0.1575829 |
| pareto_mdr_min | 0.5715410 | 0.1618162 |
| pareto_dr_min | 0.5713618 | 0.1638552 |
full %>%
group_by(tournament_type) %>%
summarise(mean_coop = mean(coop_ratio),
sd_coop = sd(coop_ratio)) %>%
arrange(desc(sd_coop)) %>%
kable(caption = "Tournament types arranged by s.d. of cooperation ratio") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
| tournament_type | mean_coop | sd_coop |
|---|---|---|
| hetero_mdr_sd_max | 0.5817933 | 0.1660426 |
| pareto_dr_min | 0.5713618 | 0.1638552 |
| pareto_mdr_min | 0.5715410 | 0.1618162 |
| pareto_mdr_max | 0.5825757 | 0.1616499 |
| hetero_dr_sd_min | 0.5789166 | 0.1612046 |
| hetero_dr_sd_max | 0.6002804 | 0.1605549 |
| hetero_m_sd_min | 0.5799698 | 0.1605414 |
| hetero_mdr_sd_min | 0.5793128 | 0.1596192 |
| pareto_m_min | 0.5747713 | 0.1575829 |
| hetero_m_sd_max | 0.5859083 | 0.1568820 |
| pareto_m_max | 0.5886649 | 0.1566004 |
| pareto_dr_max | 0.5795952 | 0.1543603 |
| homogenous | 0.5892130 | 0.1542594 |
full %>%
group_by(seed, tournament_type) %>%
mutate(round = row_number()) %>%
ungroup() %>%
filter(str_detect(tournament_type, c("pareto_dr_max", "homogenous"))) %>%
ggplot(aes(round, coop_ratio, color = tournament_type)) +
geom_smooth(color = "black") +
facet_wrap(tournament_type~seed) +
scale_color_grey(guide = F)
full %>%
group_by(seed, tournament_type) %>%
mutate(round = row_number()) %>%
ungroup() %>%
filter(str_detect(tournament_type, c("pareto_m_max", "homogenous"))) %>%
ggplot(aes(round, coop_ratio, color = tournament_type)) +
geom_smooth(color = "black") +
#geom_point(color = "black") +
facet_wrap(tournament_type~seed) +
scale_color_grey(guide = F)
full %>%
group_by(seed, tournament_type) %>%
mutate(round = row_number()) %>%
ungroup() %>%
filter(str_detect(tournament_type, c("pareto_mdr_max", "homogenous"))) %>%
ggplot(aes(round, coop_ratio, color = tournament_type)) +
geom_smooth(color = "black") +
#geom_point(color = "black") +
facet_wrap(tournament_type~seed) +
scale_color_grey(guide = F)
full %>%
group_by(seed, tournament_type) %>%
mutate(round = row_number()) %>%
ungroup() %>%
filter(str_detect(tournament_type, c("hetero_dr_sd_max", "homogenous"))) %>%
ggplot(aes(round, coop_ratio, color = tournament_type)) +
geom_smooth(color = "black") +
#geom_point(color = "black") +
facet_wrap(tournament_type~seed) +
scale_color_grey(guide = F)
full %>%
group_by(seed, tournament_type) %>%
mutate(round = row_number()) %>%
ungroup() %>%
filter(str_detect(tournament_type, c("hetero_m_sd_max", "homogenous"))) %>%
ggplot(aes(round, coop_ratio, color = tournament_type)) +
geom_smooth(color = "black") +
#geom_point(color = "black") +
facet_wrap(tournament_type~seed) +
scale_color_grey(guide = F)
full %>%
group_by(seed, tournament_type) %>%
mutate(round = row_number()) %>%
ungroup() %>%
filter(str_detect(tournament_type, c("hetero_mdr_sd_max", "homogenous"))) %>%
ggplot(aes(round, coop_ratio, color = tournament_type)) +
geom_smooth(color = "black") +
#geom_point(color = "black") +
facet_wrap(tournament_type~seed) +
scale_color_grey(guide = F)
full %>%
group_by(seed, tournament_type) %>%
mutate(round = row_number()) %>%
ungroup() %>%
filter(str_detect(tournament_type, c("hetero_dr_sd_min", "homogenous"))) %>%
ggplot(aes(round, coop_ratio, color = tournament_type)) +
geom_smooth(color = "black") +
#geom_point(color = "black") +
facet_wrap(tournament_type~seed) +
scale_color_grey(guide = F)
full %>%
group_by(seed, tournament_type) %>%
mutate(round = row_number()) %>%
ungroup() %>%
filter(str_detect(tournament_type, c("hetero_m_sd_min", "homogenous"))) %>%
ggplot(aes(round, coop_ratio, color = tournament_type)) +
geom_smooth(color = "black") +
#geom_point(color = "black") +
facet_wrap(tournament_type~seed) +
scale_color_grey(guide = F)
full %>%
group_by(seed, tournament_type) %>%
mutate(round = row_number()) %>%
ungroup() %>%
filter(str_detect(tournament_type, c("hetero_mdr_sd_min", "homogenous"))) %>%
ggplot(aes(round, coop_ratio, color = tournament_type)) +
geom_smooth(color = "black") +
#geom_point(color = "black") +
facet_wrap(tournament_type~seed) +
scale_color_grey(guide = F)
full %>%
group_by(seed, tournament_type) %>%
mutate(round = row_number()) %>%
ungroup() %>%
filter(str_detect(tournament_type, c("pareto_dr_min", "homogenous"))) %>%
ggplot(aes(round, coop_ratio, color = tournament_type)) +
geom_smooth(color = "black") +
#geom_point(color = "black") +
facet_wrap(tournament_type~seed) +
scale_color_grey(guide = F)
full %>%
group_by(seed, tournament_type) %>%
mutate(round = row_number()) %>%
ungroup() %>%
filter(str_detect(tournament_type, c("pareto_m_min", "homogenous"))) %>%
ggplot(aes(round, coop_ratio, color = tournament_type)) +
geom_smooth(color = "black") +
#geom_point(color = "black") +
facet_wrap(tournament_type~seed) +
scale_color_grey(guide = F)
full %>%
group_by(seed, tournament_type) %>%
mutate(round = row_number()) %>%
ungroup() %>%
filter(str_detect(tournament_type, c("pareto_mdr_min", "homogenous"))) %>%
ggplot(aes(round, coop_ratio, color = tournament_type)) +
geom_smooth(color = "black") +
#geom_point(color = "black") +
facet_wrap(tournament_type~seed) +
scale_color_grey(guide = F)
Data Prep
Data import
my_formula <- y ~ x
df_outliers_full %>%
ggplot() +
geom_point(aes(S.D., Counts, color = as.factor(seed))) +
geom_smooth(aes(S.D., Counts), color = "black") +
facet_wrap(~tournament_type) +
scale_color_grey(guide = F) +
labs(title = "Smooth function applied to count of outliers on standard deviation",
x = "standard deviation",
y = "count of outliers")
df_outliers_full %>%
select(x = S.D., y = Counts, tournament_type, seed) %>%
ggplot(aes(x = x, y = y)) +
geom_point(aes(x, y, color = as.factor(seed))) +
geom_smooth(method = "lm", color = "black", se=FALSE, formula = my_formula) +
stat_poly_eq(formula = my_formula,
aes(label = paste(..eq.label.., sep = "~~~")),
parse = TRUE,
label.x = 2) +
facet_wrap(~tournament_type) +
scale_color_grey(guide = F) +
labs(title = "Linear function applied to count of outliers on standard deviation",
x = "standard deviation",
y = "count of outliers")
df_outliers_full %>%
filter(S.D. <= 1.5) %>%
select(x = S.D., y = Counts, tournament_type, seed) %>%
ggplot(aes(x = x, y = y)) +
geom_point(aes(x, y, color = as.factor(seed))) +
geom_smooth(method = "lm", color = "black", se=FALSE, formula = my_formula) +
stat_poly_eq(formula = my_formula,
aes(label = paste(..eq.label.., sep = "~~~")),
parse = TRUE,
label.x = 2) +
facet_wrap(~tournament_type) +
scale_color_grey(guide = F) +
labs(title = "Linear function applied to count of outliers on standard deviation",
subtitle = "Range of S.D. limited from 0 to 1.5",
x = "standard deviation",
y = "count of outliers")
df_outliers_full %>%
filter(S.D. >= 1.5) %>%
select(x = S.D., y = Counts, tournament_type, seed) %>%
ggplot(aes(x = x, y = y)) +
geom_point(aes(x, y, color = as.factor(seed))) +
geom_smooth(method = "lm", color = "black", se=FALSE, formula = my_formula) +
stat_poly_eq(formula = my_formula,
aes(label = paste(..eq.label.., sep = "~~~")),
parse = TRUE,
label.x = 2) +
facet_wrap(~tournament_type) +
scale_color_grey(guide = F) +
labs(title = "Linear function applied to count of outliers on standard deviation",
subtitle = "Range of S.D. limited from 1.5 to 3",
x = "standard deviation",
y = "count of outliers")
df_outliers_full %>%
group_by(as.factor(tournament_type)) %>%
do({
mod = lm(Counts ~ S.D., data = .)
data.frame(Intercept = coef(mod)[1],
Slope = coef(mod)[2],
R2 = summary(mod)$r.squared)
}) %>%
arrange(desc(Intercept)) %>%
kable() %>%
kable_styling()
| as.factor(tournament_type) | Intercept | Slope | R2 |
|---|---|---|---|
| pareto_dr_max | 318.9619 | -124.5255 | 0.9151360 |
| control_group | 313.9496 | -121.9624 | 0.9149856 |
| pareto_m_max | 309.6571 | -120.7227 | 0.9116794 |
| norm_m_sd_max | 305.0884 | -118.9032 | 0.9102347 |
| norm_mdr_sd_min | 304.7535 | -119.0130 | 0.9043898 |
| pareto_mdr_min | 300.6716 | -117.2629 | 0.9114020 |
| pareto_m_min | 299.2762 | -116.3644 | 0.9159300 |
| norm_dr_sd_min | 295.8781 | -115.0315 | 0.9208328 |
| pareto_dr_min | 295.6928 | -115.4574 | 0.9107716 |
| norm_m_sd_min | 294.6364 | -114.5549 | 0.9221166 |
| pareto_mdr_max | 293.8838 | -114.2017 | 0.9117865 |
| norm_dr_sd_max | 293.4010 | -114.0533 | 0.9138033 |
| norm_mdr_sd_max | 290.0874 | -112.9884 | 0.9226192 |
df_outliers_full %>%
group_by(as.factor(tournament_type)) %>%
do({
mod = lm(Counts ~ S.D., data = .)
data.frame(Intercept = coef(mod)[1],
Slope = coef(mod)[2],
R2 = summary(mod)$r.squared)
}) %>%
arrange(desc(Slope)) %>%
kable() %>%
kable_styling()
| as.factor(tournament_type) | Intercept | Slope | R2 |
|---|---|---|---|
| norm_mdr_sd_max | 290.0874 | -112.9884 | 0.9226192 |
| norm_dr_sd_max | 293.4010 | -114.0533 | 0.9138033 |
| pareto_mdr_max | 293.8838 | -114.2017 | 0.9117865 |
| norm_m_sd_min | 294.6364 | -114.5549 | 0.9221166 |
| norm_dr_sd_min | 295.8781 | -115.0315 | 0.9208328 |
| pareto_dr_min | 295.6928 | -115.4574 | 0.9107716 |
| pareto_m_min | 299.2762 | -116.3644 | 0.9159300 |
| pareto_mdr_min | 300.6716 | -117.2629 | 0.9114020 |
| norm_m_sd_max | 305.0884 | -118.9032 | 0.9102347 |
| norm_mdr_sd_min | 304.7535 | -119.0130 | 0.9043898 |
| pareto_m_max | 309.6571 | -120.7227 | 0.9116794 |
| control_group | 313.9496 | -121.9624 | 0.9149856 |
| pareto_dr_max | 318.9619 | -124.5255 | 0.9151360 |
df_outliers_full %>%
filter(S.D. >= 1.5) %>%
group_by(as.factor(tournament_type)) %>%
do({
mod = lm(Counts ~ S.D., data = .)
data.frame(Intercept = coef(mod)[1],
Slope = coef(mod)[2],
R2 = summary(mod)$r.squared)
}) %>%
arrange(desc(Intercept)) %>%
kable() %>%
kable_styling()
| as.factor(tournament_type) | Intercept | Slope | R2 |
|---|---|---|---|
| control_group | 193.8478 | -71.48235 | 0.7876658 |
| pareto_dr_max | 186.0338 | -68.77059 | 0.8088354 |
| norm_dr_sd_min | 185.9125 | -68.92500 | 0.8334723 |
| pareto_m_max | 185.5368 | -68.61912 | 0.8044666 |
| norm_m_sd_min | 185.2934 | -68.67206 | 0.8164341 |
| norm_mdr_sd_max | 181.2279 | -67.39853 | 0.7971754 |
| pareto_mdr_max | 178.9463 | -65.77059 | 0.8186737 |
| pareto_mdr_min | 178.7713 | -66.17059 | 0.8256462 |
| norm_dr_sd_max | 176.3926 | -65.04118 | 0.8046657 |
| norm_m_sd_max | 172.1493 | -63.04412 | 0.8244890 |
| pareto_m_min | 171.8176 | -62.84118 | 0.8271148 |
| pareto_dr_min | 171.7963 | -63.37059 | 0.8370174 |
| norm_mdr_sd_min | 170.6169 | -62.63529 | 0.7871810 |
df_outliers_full %>%
filter(S.D. >= 1.5) %>%
group_by(as.factor(tournament_type)) %>%
do({
mod = lm(Counts ~ S.D., data = .)
data.frame(Intercept = coef(mod)[1],
Slope = coef(mod)[2],
R2 = summary(mod)$r.squared)
}) %>%
arrange(desc(Slope)) %>%
kable() %>%
kable_styling()
| as.factor(tournament_type) | Intercept | Slope | R2 |
|---|---|---|---|
| norm_mdr_sd_min | 170.6169 | -62.63529 | 0.7871810 |
| pareto_m_min | 171.8176 | -62.84118 | 0.8271148 |
| norm_m_sd_max | 172.1493 | -63.04412 | 0.8244890 |
| pareto_dr_min | 171.7963 | -63.37059 | 0.8370174 |
| norm_dr_sd_max | 176.3926 | -65.04118 | 0.8046657 |
| pareto_mdr_max | 178.9463 | -65.77059 | 0.8186737 |
| pareto_mdr_min | 178.7713 | -66.17059 | 0.8256462 |
| norm_mdr_sd_max | 181.2279 | -67.39853 | 0.7971754 |
| pareto_m_max | 185.5368 | -68.61912 | 0.8044666 |
| norm_m_sd_min | 185.2934 | -68.67206 | 0.8164341 |
| pareto_dr_max | 186.0338 | -68.77059 | 0.8088354 |
| norm_dr_sd_min | 185.9125 | -68.92500 | 0.8334723 |
| control_group | 193.8478 | -71.48235 | 0.7876658 |
df_outliers_full %>%
filter(S.D. <= 1.5) %>%
group_by(as.factor(tournament_type)) %>%
do({
mod = lm(Counts ~ S.D., data = .)
data.frame(Intercept = coef(mod)[1],
Slope = coef(mod)[2],
R2 = summary(mod)$r.squared)
}) %>%
arrange(desc(Intercept)) %>%
kable() %>%
kable_styling()
| as.factor(tournament_type) | Intercept | Slope | R2 |
|---|---|---|---|
| pareto_dr_max | 374.7909 | -171.6273 | 0.9115656 |
| norm_mdr_sd_min | 366.8455 | -172.9364 | 0.9000166 |
| control_group | 366.7818 | -166.7818 | 0.8821214 |
| norm_m_sd_max | 364.4545 | -169.7364 | 0.9126566 |
| pareto_m_max | 361.1273 | -163.5818 | 0.8732808 |
| pareto_m_min | 355.0000 | -163.8364 | 0.9307597 |
| pareto_dr_min | 353.6909 | -165.9818 | 0.8884670 |
| pareto_mdr_min | 350.3091 | -158.7636 | 0.8550133 |
| pareto_mdr_max | 350.1545 | -163.3909 | 0.8820445 |
| norm_dr_sd_min | 340.1091 | -151.6727 | 0.8697545 |
| norm_m_sd_min | 339.6182 | -151.9818 | 0.8952851 |
| norm_dr_sd_max | 339.1091 | -151.6727 | 0.8704247 |
| norm_mdr_sd_max | 331.2273 | -146.3182 | 0.9065081 |
df_outliers_full %>%
filter(S.D. <= 1.5) %>%
group_by(as.factor(tournament_type)) %>%
do({
mod = lm(Counts ~ S.D., data = .)
data.frame(Intercept = coef(mod)[1],
Slope = coef(mod)[2],
R2 = summary(mod)$r.squared)
}) %>%
arrange(desc(Slope)) %>%
kable() %>%
kable_styling()
| as.factor(tournament_type) | Intercept | Slope | R2 |
|---|---|---|---|
| norm_mdr_sd_max | 331.2273 | -146.3182 | 0.9065081 |
| norm_dr_sd_max | 339.1091 | -151.6727 | 0.8704247 |
| norm_dr_sd_min | 340.1091 | -151.6727 | 0.8697545 |
| norm_m_sd_min | 339.6182 | -151.9818 | 0.8952851 |
| pareto_mdr_min | 350.3091 | -158.7636 | 0.8550133 |
| pareto_mdr_max | 350.1545 | -163.3909 | 0.8820445 |
| pareto_m_max | 361.1273 | -163.5818 | 0.8732808 |
| pareto_m_min | 355.0000 | -163.8364 | 0.9307597 |
| pareto_dr_min | 353.6909 | -165.9818 | 0.8884670 |
| control_group | 366.7818 | -166.7818 | 0.8821214 |
| norm_m_sd_max | 364.4545 | -169.7364 | 0.9126566 |
| pareto_dr_max | 374.7909 | -171.6273 | 0.9115656 |
| norm_mdr_sd_min | 366.8455 | -172.9364 | 0.9000166 |